Load all required libraries.
library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.3 v dplyr 1.0.7
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 2.0.0 v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(plotly)
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(broom)
Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")
Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))
Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')
#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]
Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1
p2
Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))
## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")
wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))
## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")
wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))
## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")
#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)
Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 420)
## Warning: Ignoring unknown aesthetics: outfit
#look at the fits to align dates and total observations
#both
extract_botha
## `geom_smooth()` using formula 'y ~ x'
fit_botha
## [1] 13.01275 13.00936 13.00601 13.00268 12.99940 12.99614 12.99292 12.98973
## [9] 12.98657 12.98345 12.98037 12.97732 12.97431 12.97133 12.96840 12.96550
## [17] 12.96264 12.95981 12.95703 12.95429 12.95158 12.94892 12.94630 12.94372
## [25] 12.94118 12.93869 12.93624 12.93383 12.93146 12.92915 12.92687 12.92464
## [33] 12.92246 12.92032 12.91824 12.91619 12.91420 12.91226 12.91036 12.90851
## [41] 12.90672 12.90497 12.90327 12.90164 12.90007 12.89858 12.89715 12.89578
## [49] 12.89448 12.89324 12.89206 12.89094 12.88988 12.88888 12.88793 12.88703
## [57] 12.88619 12.88540 12.88466 12.88397 12.88333 12.88273 12.88218 12.88167
## [65] 12.88120 12.88077 12.88038 12.88003 12.87972 12.87944 12.87919 12.87898
## [73] 12.87879 12.87864 12.87851 12.87842 12.87834 12.87829 12.87827 12.87826
## [81] 12.87828 12.87831 12.87836 12.87843 12.87851 12.87865 12.87890 12.87925
## [89] 12.87969 12.88023 12.88086 12.88158 12.88238 12.88326 12.88421 12.88523
## [97] 12.88632 12.88748 12.88870 12.88997 12.89129 12.89267 12.89409 12.89554
## [105] 12.89704 12.89857 12.90013 12.90172 12.90333 12.90496 12.90660 12.90826
## [113] 12.90992 12.91158 12.91325 12.91491 12.91656 12.91821 12.91983 12.92144
## [121] 12.92303 12.92459 12.92612 12.92761 12.92907 12.93048 12.93185 12.93317
## [129] 12.93493 12.93757 12.94098 12.94508 12.94978 12.95499 12.96061 12.96657
## [137] 12.97276 12.97909 12.98549 12.99184 12.99808 13.00409 13.00980 13.01512
## [145] 13.01994 13.02419 13.02777 13.03060 13.03257 13.03507 13.03942 13.04542
## [153] 13.05286 13.06155 13.07129 13.08189 13.09314 13.10484 13.11681 13.12884
## [161] 13.14073 13.15228 13.16330 13.17359 13.18295 13.19118 13.19808 13.20347
## [169] 13.20713 13.20886 13.20960 13.21035 13.21111 13.21187 13.21259 13.21328
## [177] 13.21391 13.21447 13.21494 13.21530 13.21554 13.21564 13.21558 13.21535
## [185] 13.21494 13.21432 13.21348 13.21241 13.21108 13.20948 13.20760 13.20542
## [193] 13.20292 13.20009 13.19690 13.19335 13.18941 13.18508 13.18033 13.17515
## [201] 13.16952 13.16343 13.15686 13.14979 13.14157 13.13167 13.12024 13.10746
## [209] 13.09347 13.07844 13.06253 13.04590 13.02871 13.01113 12.99330 12.97540
## [217] 12.95758 12.94001 12.92284 12.90623 12.89035 12.87535 12.86140 12.84866
## [225] 12.83537 12.81983 12.80225 12.78285 12.76187 12.73951 12.71599 12.69155
## [233] 12.66640 12.64076 12.61485 12.58889 12.56310 12.53771 12.51294 12.48900
## [241] 12.46612 12.44451 12.42441 12.40602 12.38958 12.37399 12.35804 12.34178
## [249] 12.32525 12.30849 12.29153 12.27443 12.25721 12.23993 12.22262 12.20532
## [257] 12.18808 12.17093 12.15392 12.13709 12.12047 12.10412 12.08806 12.07234
## [265] 12.05701 12.04209 12.02764 12.01370 12.00047 11.98809 11.97649 11.96561
## [273] 11.95536 11.94567 11.93648 11.92771 11.91929 11.91115 11.90321 11.89541
## [281] 11.88767 11.87992 11.87208 11.86409 11.85588 11.84736 11.83848 11.82916
## [289] 11.81932 11.80919 11.79906 11.78895 11.77889 11.76888 11.75896 11.74914
## [297] 11.73943 11.72988 11.72048 11.71127 11.70226 11.69347 11.68493 11.67665
## [305] 11.66865 11.66096 11.65360 11.64658 11.63992 11.63366 11.62695 11.61906
## [313] 11.61015 11.60038 11.58992 11.57892 11.56754 11.55595 11.54430 11.53276
## [321] 11.52149 11.51063 11.50037 11.49085 11.48224 11.47469 11.46838 11.46345
## [329] 11.46007 11.45840 11.45860 11.45972 11.46076 11.46177 11.46279 11.46389
## [337] 11.46512 11.46652 11.46817 11.47010 11.47237 11.47505 11.47817 11.48179
## [345] 11.48598 11.49078 11.49624 11.50242 11.50938 11.51716 11.52583 11.53543
## [353] 11.54562 11.55605 11.56673 11.57767 11.58891 11.60045 11.61232 11.62453
## [361] 11.63711 11.65007 11.66343 11.67721 11.69143 11.70610 11.72126 11.73691
## [369] 11.75307 11.76977 11.78702 11.80484 11.82325 11.84227 11.86192 11.88221
## [377] 11.90317 11.92481 11.94702 11.96966 11.99275 12.01628 12.04027 12.06472
## [385] 12.08964 12.11503 12.14090 12.16726 12.19411 12.22146 12.24932 12.27768
## [393] 12.30657 12.33597 12.36591 12.39639 12.42740 12.45897 12.49109 12.52384
## [401] 12.55729 12.59140 12.62618 12.66160 12.69764 12.73430 12.77155 12.80938
## [409] 12.84778 12.88672 12.92619 12.96618 13.00667 13.04764 13.08908 13.13097
## [417] 13.17330 13.21605 13.25921 13.30275
#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data
## `geom_smooth()` using formula 'y ~ x'
limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)
#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_a
save(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")
#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 420)
## Warning: Ignoring unknown aesthetics: outfit
#look at the fits to align dates and total observations
#both
extract_bothb
## `geom_smooth()` using formula 'y ~ x'
fit_bothb
## [1] 12.51998 12.51942 12.51888 12.51837 12.51788 12.51742 12.51699 12.51659
## [9] 12.51622 12.51588 12.51557 12.51530 12.51507 12.51487 12.51471 12.51460
## [17] 12.51452 12.51448 12.51449 12.51455 12.51465 12.51479 12.51499 12.51524
## [25] 12.51553 12.51588 12.51628 12.51674 12.51726 12.51783 12.51846 12.51915
## [33] 12.51990 12.52071 12.52159 12.52253 12.52354 12.52462 12.52576 12.52698
## [41] 12.52826 12.52962 12.53105 12.53257 12.53416 12.53583 12.53758 12.53941
## [49] 12.54131 12.54328 12.54532 12.54743 12.54960 12.55184 12.55414 12.55649
## [57] 12.55890 12.56137 12.56389 12.56646 12.56907 12.57173 12.57444 12.57719
## [65] 12.57997 12.58280 12.58565 12.58854 12.59147 12.59442 12.59739 12.60040
## [73] 12.60342 12.60646 12.60953 12.61260 12.61569 12.61880 12.62191 12.62503
## [81] 12.62815 12.63128 12.63441 12.63754 12.64066 12.64390 12.64739 12.65110
## [89] 12.65503 12.65917 12.66350 12.66802 12.67271 12.67756 12.68256 12.68769
## [97] 12.69296 12.69834 12.70382 12.70940 12.71506 12.72079 12.72658 12.73242
## [105] 12.73829 12.74419 12.75010 12.75602 12.76193 12.76782 12.77368 12.77949
## [113] 12.78525 12.79095 12.79657 12.80210 12.80754 12.81286 12.81807 12.82314
## [121] 12.82806 12.83284 12.83744 12.84187 12.84611 12.85014 12.85452 12.85972
## [129] 12.86566 12.87224 12.87937 12.88696 12.89492 12.90315 12.91157 12.92008
## [137] 12.92859 12.93701 12.94525 12.95321 12.96080 12.96794 12.97452 12.98047
## [145] 12.98568 12.99007 12.99353 12.99713 13.00189 13.00769 13.01440 13.02191
## [153] 13.03011 13.03887 13.04807 13.05759 13.06731 13.07712 13.08690 13.09652
## [161] 13.10586 13.11482 13.12326 13.13107 13.13813 13.14431 13.14951 13.15360
## [169] 13.15647 13.15798 13.15867 13.15915 13.15942 13.15946 13.15929 13.15890
## [177] 13.15829 13.15746 13.15640 13.15512 13.15362 13.15189 13.14994 13.14776
## [185] 13.14534 13.14270 13.13983 13.13673 13.13340 13.12983 13.12603 13.12199
## [193] 13.11771 13.11320 13.10844 13.10345 13.09822 13.09274 13.08702 13.08106
## [201] 13.07485 13.06840 13.06169 13.05474 13.04640 13.03566 13.02279 13.00801
## [209] 12.99158 12.97373 12.95471 12.93475 12.91411 12.89302 12.87173 12.85047
## [217] 12.82950 12.80904 12.78936 12.77068 12.75325 12.73731 12.72310 12.71088
## [225] 12.69872 12.68469 12.66899 12.65180 12.63331 12.61372 12.59321 12.57199
## [233] 12.55023 12.52813 12.50588 12.48368 12.46171 12.44016 12.41923 12.39911
## [241] 12.37998 12.36205 12.34550 12.33051 12.31730 12.30527 12.29370 12.28256
## [249] 12.27182 12.26143 12.25135 12.24156 12.23202 12.22269 12.21353 12.20451
## [257] 12.19560 12.18674 12.17792 12.16909 12.16022 12.15127 12.14221 12.13299
## [265] 12.12359 12.11396 12.10407 12.09389 12.08410 12.07538 12.06762 12.06072
## [273] 12.05459 12.04912 12.04421 12.03977 12.03570 12.03191 12.02828 12.02472
## [281] 12.02114 12.01744 12.01351 12.00926 12.00459 11.99940 11.99359 11.98706
## [289] 11.97972 11.97200 11.96440 11.95693 11.94957 11.94233 11.93521 11.92821
## [297] 11.92132 11.91455 11.90790 11.90136 11.89493 11.88862 11.88241 11.87632
## [305] 11.87033 11.86446 11.85869 11.85303 11.84747 11.84202 11.83579 11.82803
## [313] 11.81893 11.80867 11.79746 11.78548 11.77292 11.75999 11.74686 11.73373
## [321] 11.72079 11.70823 11.69625 11.68504 11.67479 11.66568 11.65792 11.65169
## [329] 11.64718 11.64459 11.64411 11.64462 11.64489 11.64499 11.64498 11.64493
## [337] 11.64488 11.64492 11.64509 11.64546 11.64609 11.64703 11.64836 11.65013
## [345] 11.65241 11.65525 11.65871 11.66287 11.66777 11.67348 11.68006 11.68758
## [353] 11.69564 11.70384 11.71219 11.72072 11.72945 11.73840 11.74759 11.75704
## [361] 11.76677 11.77681 11.78717 11.79788 11.80896 11.82042 11.83230 11.84461
## [369] 11.85737 11.87060 11.88434 11.89858 11.91337 11.92871 11.94464 11.96116
## [377] 11.97831 11.99610 12.01440 12.03307 12.05211 12.07152 12.09133 12.11152
## [385] 12.13212 12.15312 12.17454 12.19638 12.21865 12.24135 12.26449 12.28809
## [393] 12.31214 12.33665 12.36163 12.38709 12.41304 12.43947 12.46640 12.49393
## [401] 12.52213 12.55099 12.58047 12.61057 12.64126 12.67253 12.70435 12.73671
## [409] 12.76958 12.80294 12.83678 12.87108 12.90581 12.94096 12.97650 13.01242
## [417] 13.04870 13.08532 13.12225 13.15948
#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data
## `geom_smooth()` using formula 'y ~ x'
limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)
#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_b
save(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")
#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 420)
## Warning: Ignoring unknown aesthetics: outfit
#look at the fits to align dates and total observations
#both
extract_bothc
## `geom_smooth()` using formula 'y ~ x'
fit_bothc
## [1] 11.99091 11.98628 11.98171 11.97722 11.97279 11.96843 11.96415 11.95994
## [9] 11.95580 11.95173 11.94774 11.94382 11.93997 11.93620 11.93250 11.92888
## [17] 11.92534 11.92187 11.91848 11.91517 11.91193 11.90878 11.90570 11.90270
## [25] 11.89978 11.89695 11.89419 11.89152 11.88893 11.88642 11.88399 11.88165
## [33] 11.87939 11.87722 11.87513 11.87313 11.87121 11.86938 11.86764 11.86598
## [41] 11.86441 11.86294 11.86155 11.86025 11.85904 11.85792 11.85689 11.85595
## [49] 11.85511 11.85436 11.85373 11.85324 11.85290 11.85270 11.85264 11.85271
## [57] 11.85291 11.85323 11.85368 11.85424 11.85492 11.85571 11.85661 11.85761
## [65] 11.85871 11.85991 11.86120 11.86259 11.86405 11.86560 11.86723 11.86893
## [73] 11.87070 11.87254 11.87445 11.87641 11.87843 11.88051 11.88263 11.88480
## [81] 11.88701 11.88926 11.89155 11.89386 11.89621 11.89858 11.90096 11.90337
## [89] 11.90579 11.90822 11.91065 11.91309 11.91558 11.91818 11.92088 11.92369
## [97] 11.92660 11.92961 11.93271 11.93591 11.93920 11.94257 11.94604 11.94958
## [105] 11.95321 11.95692 11.96070 11.96455 11.96848 11.97248 11.97654 11.98066
## [113] 11.98485 11.98910 11.99340 11.99775 12.00216 12.00662 12.01112 12.01567
## [121] 12.02025 12.02488 12.02954 12.03424 12.03897 12.04373 12.04851 12.05332
## [129] 12.05894 12.06606 12.07452 12.08419 12.09492 12.10655 12.11893 12.13193
## [137] 12.14539 12.15917 12.17311 12.18707 12.20091 12.21446 12.22759 12.24015
## [145] 12.25198 12.26295 12.27290 12.28169 12.28916 12.29748 12.30869 12.32250
## [153] 12.33858 12.35665 12.37638 12.39747 12.41961 12.44250 12.46582 12.48928
## [161] 12.51256 12.53535 12.55736 12.57826 12.59776 12.61554 12.63130 12.64473
## [169] 12.65553 12.66338 12.66963 12.67582 12.68192 12.68793 12.69382 12.69958
## [177] 12.70518 12.71061 12.71584 12.72087 12.72566 12.73022 12.73450 12.73851
## [185] 12.74221 12.74559 12.74863 12.75131 12.75362 12.75554 12.75704 12.75811
## [193] 12.75874 12.75889 12.75856 12.75773 12.75637 12.75447 12.75201 12.74898
## [201] 12.74534 12.74110 12.73621 12.73068 12.72327 12.71296 12.70004 12.68480
## [209] 12.66752 12.64849 12.62800 12.60635 12.58380 12.56066 12.53722 12.51375
## [217] 12.49054 12.46790 12.44609 12.42542 12.40616 12.38861 12.37305 12.35978
## [225] 12.34668 12.33160 12.31474 12.29629 12.27644 12.25539 12.23334 12.21048
## [233] 12.18701 12.16313 12.13902 12.11488 12.09092 12.06732 12.04429 12.02201
## [241] 12.00068 11.98050 11.96167 11.94437 11.92882 11.91408 11.89914 11.88403
## [249] 11.86876 11.85337 11.83788 11.82232 11.80671 11.79107 11.77544 11.75985
## [257] 11.74430 11.72884 11.71348 11.69826 11.68319 11.66831 11.65364 11.63920
## [265] 11.62502 11.61114 11.59756 11.58432 11.57140 11.55876 11.54639 11.53427
## [273] 11.52241 11.51079 11.49941 11.48825 11.47731 11.46659 11.45606 11.44572
## [281] 11.43557 11.42560 11.41579 11.40614 11.39664 11.38729 11.37807 11.36897
## [289] 11.35999 11.35127 11.34295 11.33501 11.32743 11.32019 11.31329 11.30670
## [297] 11.30040 11.29438 11.28863 11.28312 11.27783 11.27276 11.26788 11.26318
## [305] 11.25864 11.25424 11.24997 11.24581 11.24174 11.23775 11.23336 11.22819
## [313] 11.22235 11.21595 11.20911 11.20195 11.19457 11.18710 11.17963 11.17230
## [321] 11.16521 11.15848 11.15221 11.14654 11.14155 11.13739 11.13414 11.13194
## [329] 11.13089 11.13111 11.13272 11.13500 11.13721 11.13941 11.14162 11.14390
## [337] 11.14629 11.14883 11.15157 11.15455 11.15782 11.16142 11.16539 11.16979
## [345] 11.17464 11.18000 11.18592 11.19243 11.19958 11.20741 11.21597 11.22530
## [353] 11.23513 11.24515 11.25539 11.26585 11.27656 11.28752 11.29876 11.31029
## [361] 11.32212 11.33428 11.34677 11.35961 11.37282 11.38642 11.40041 11.41482
## [369] 11.42966 11.44495 11.46069 11.47691 11.49363 11.51085 11.52860 11.54688
## [377] 11.56572 11.58513 11.60502 11.62528 11.64591 11.66692 11.68832 11.71010
## [385] 11.73227 11.75484 11.77781 11.80119 11.82497 11.84917 11.87378 11.89881
## [393] 11.92426 11.95015 11.97646 12.00321 12.03041 12.05805 12.08613 12.11472
## [401] 12.14384 12.17349 12.20365 12.23431 12.26547 12.29712 12.32924 12.36181
## [409] 12.39484 12.42832 12.46222 12.49654 12.53127 12.56640 12.60192 12.63781
## [417] 12.67407 12.71069 12.74765 12.78495
#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data
## `geom_smooth()` using formula 'y ~ x'
limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)
#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_c
save(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")
save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")
save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")
save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")